Collection of Tools & Utilities/Collection of Tools and Utilities.iso/graphic/ncuerm10.zip/FILE.TXT

Text File | 1994-04-14 | 8KB | 238 lines

Sub Button_Canel_Click ()
    tools.Enabled = True
    main.Enabled = True
    main.Show
    file.Hide
End Sub

Sub Button_OK_click ()
    Dim FileNum, i As Integer
    Dim tempStr As String

    If Left$(SaveOrLoad$, 4) = "Save" Then
      A_filename = Text1.Text
      For i = 0 To File1.ListCount - 1
        If A_filename = File1.List(i) Then
          If MsgBox(A_filename + " file already exists, replace it? ", 4 + 48, "Replace file") = 7 Then Exit Sub
          Exit For
        End If
      Next i
      Call FileSave
      If SaveOrLoad$ = "SaveFailure" Then Exit Sub
    End If

    If SaveOrLoad = "Load" Then
      FileNum = FreeFile
      For i = 0 To file.File1.ListCount - 1
        If Text1.Text = File1.List(i) Then
          Open Text1.Text For Input Access Read As #FileNum
          Input #FileNum, tempStr$
          If Left$(tempStr$, 14) <> "MacbearERModel" Then
            MsgBox Text1.Text + " file is not used for this software", 48, "File Format Error"
            Exit Sub
          End If
          A_filename$ = Text1.Text
          Call FileLoad(FileNum)
          Call DotAllHide
          Close #FileNum
          GoTo OVER_FILE
        End If
      Next i
      MsgBox Text1.Text + " file not found", 32, "Error Message"
      Exit Sub
    End If

OVER_FILE:
    tools.Enabled = True
    main.Enabled = True
    main.Show
    file.Hide
    main.Caption = "ER Model (" + A_filename$ + ")"
End Sub

Sub Dir1_Change ()
    File1.Path = Dir1.Path
    Label_Dir.Caption = Dir1.Path
    ChDrive Left(Label_Dir.Caption, 2)
    ChDir Label_Dir.Caption
End Sub

Sub Drive1_Change ()
    On Error GoTo ERR_DRIVE
    Dir1.Path = Drive1.Drive
    Exit Sub
ERR_DRIVE:
    MsgBox Drive1.Drive + " disk drive error", 48, "Error Message"
    Drive1.Drive = Left(Label_Dir.Caption, 2)
    Resume Next
End Sub

Sub File1_Click ()
    Text1.Text = File1.FileName
End Sub

Sub File1_DblClick ()
    Call Button_OK_click
End Sub

Sub FileLoad (ByVal FileNum As Integer)
    Dim i, CountNumas As Integer
    Dim tempInt As Integer
    Dim tempSin As Single
    Dim tempStr As String

    Screen.MousePointer = 11 'Wait Icon

    For i = 1 To 1000
      If DataText(i) = 1 Then Unload main.Text1(i)
      If DataLine(i) = 1 Then Unload main.Line1(i)
      If DataRectangle(i) = 1 Then Unload main.Rectangle1(i)
      If DataRoundrectangle(i) = 1 Then Unload main.RoundRectangle1(i)
      If DataCircle(i) = 1 Then Unload main.Circle1(i)
      If DataDiamond(i) = 1 Then
        Unload main.Diamond(i)
        Unload main.Diamond1(i * 4)
        Unload main.Diamond1(i * 4 + 1)
        Unload main.Diamond1(i * 4 + 2)
        Unload main.Diamond1(i * 4 + 3)
      End If
    Next i
    For i = 1 To 1000
      DataText(i) = 0
      DataLine(i) = 0
      DataRectangle(i) = 0
      DataRoundrectangle(i) = 0
      DataCircle(i) = 0
      DataDiamond(i) = 0
    Next i
    MaxText = 0
    MaxLine = 0
    MaxRectangle = 0
    MaxRoundrectangle = 0
    MaxCircle = 0
    MaxDiamond = 0

    'Read Diamond Data
    Input #FileNum, CountNum
    MaxDiamond = CountNum
    For i = 1 To CountNum
      Load main.Diamond(i)
      Load main.Diamond1(i * 4)
      Load main.Diamond1(i * 4 + 1)
      Load main.Diamond1(i * 4 + 2)
      Load main.Diamond1(i * 4 + 3)
      Input #FileNum, tempInt: main.Diamond(i).BorderStyle = tempInt
      Input #FileNum, tempInt: main.Diamond(i).BorderWidth = tempInt
      Input #FileNum, tempSin: main.Diamond(i).Height = tempSin
      Input #FileNum, tempSin: main.Diamond(i).Left = tempSin
      Input #FileNum, tempSin: main.Diamond(i).Top = tempSin
      Input #FileNum, tempSin: main.Diamond(i).Width = tempSin
      Call DiamondDraw(main.Diamond(i), i)
      DataDiamond(i) = 1
    Next i
    'Read Circle Data
    Input #FileNum, CountNum
    MaxCircle = CountNum
    For i = 1 To CountNum
      Load main.Circle1(i)
      Input #FileNum, tempInt: main.Circle1(i).BorderStyle = tempInt
      Input #FileNum, tempInt: main.Circle1(i).BorderWidth = tempInt
      Input #FileNum, tempSin: main.Circle1(i).Height = tempSin
      Input #FileNum, tempSin: main.Circle1(i).Left = tempSin
      Input #FileNum, tempSin: main.Circle1(i).Top = tempSin
      Input #FileNum, tempSin: main.Circle1(i).Width = tempSin
      DataCircle(i) = 1
      main.Circle1(i).Visible = True
    Next i
    'Read Roundrectangle Data
    Input #FileNum, CountNum
    MaxRoundrectangle = CountNum
    For i = 1 To CountNum
      Load main.RoundRectangle1(i)
      Input #FileNum, tempInt: main.RoundRectangle1(i).BorderStyle = tempInt
      Input #FileNum, tempInt: main.RoundRectangle1(i).BorderWidth = tempInt
      Input #FileNum, tempSin: main.RoundRectangle1(i).Height = tempSin
      Input #FileNum, tempSin: main.RoundRectangle1(i).Left = tempSin
      Input #FileNum, tempSin: main.RoundRectangle1(i).Top = tempSin
      Input #FileNum, tempSin: main.RoundRectangle1(i).Width = tempSin
      DataRoundrectangle(i) = 1
      main.RoundRectangle1(i).Visible = True
    Next i
    'Read Rectangle Data
    Input #FileNum, CountNum
    MaxRectangle = CountNum
    For i = 1 To CountNum
      Load main.Rectangle1(i)
      Input #FileNum, tempInt: main.Rectangle1(i).BorderStyle = tempInt
      Input #FileNum, tempInt: main.Rectangle1(i).BorderWidth = tempInt
      Input #FileNum, tempSin: main.Rectangle1(i).Height = tempSin
      Input #FileNum, tempSin: main.Rectangle1(i).Left = tempSin
      Input #FileNum, tempSin: main.Rectangle1(i).Top = tempSin
      Input #FileNum, tempSin: main.Rectangle1(i).Width = tempSin
      DataRectangle(i) = 1
      main.Rectangle1(i).Visible = True
    Next i
    'Read Line Data
    Input #FileNum, CountNum
    MaxLine = CountNum
    For i = 1 To CountNum
      Load main.Line1(i)
      Input #FileNum, tempInt: main.Line1(i).BorderStyle = tempInt
      Input #FileNum, tempInt: main.Line1(i).BorderWidth = tempInt
      Input #FileNum, tempSin: main.Line1(i).X1 = tempSin
      Input #FileNum, tempSin: main.Line1(i).X2 = tempSin
      Input #FileNum, tempSin: main.Line1(i).Y1 = tempSin
      Input #FileNum, tempSin: main.Line1(i).Y2 = tempSin
      DataLine(i) = 1
      main.Line1(i).Visible = True
    Next i
    'Read Text Data
    Input #FileNum, CountNum
    MaxText = CountNum
    For i = 1 To CountNum
      Load main.Text1(i)
      main.Text1(i).BackColor = RGB(&HFF, &HFF, &HFF)
      Input #FileNum, tempInt: main.Text1(i).FontBold = tempInt
      Input #FileNum, tempInt: main.Text1(i).FontItalic = tempInt
      Input #FileNum, tempStr: main.Text1(i).FontName = tempStr
      Input #FileNum, tempSin: main.Text1(i).FontSize = tempSin
      Input #FileNum, tempInt: main.Text1(i).FontStrikethru = tempInt
      Input #FileNum, tempInt: main.Text1(i).FontUnderline = tempInt
      Input #FileNum, tempSin: main.Text1(i).Height = tempSin
      Input #FileNum, tempSin: main.Text1(i).Left = tempSin
      Input #FileNum, tempSin: main.Text1(i).Top = tempSin
      Input #FileNum, tempSin: main.Text1(i).Width = tempSin
      Input #FileNum, tempStr: main.Text1(i).Text = tempStr
      DataText(i) = 1
      main.Text1(i).Visible = True
    Next i

    Screen.MousePointer = 0 'Default Icon
End Sub

Sub Form_Activate ()
    Label_Drive = Drive1.Drive
    Label_Dir.Caption = Dir1.Path
    File1.Pattern = "*.erm"
    Text1.Text = "*.erm"
    temp_filename$ = A_filename$
End Sub

Sub Text1_KeyPress (KeyAscii As Integer)
    If KeyAscii = 13 Then   'ENTER KEY DETECTED
      KeyAscii = 0
      Call Text1_LostFocus
    End If
End Sub

Sub Text1_LostFocus ()
    On Error GoTo ERR_PATTERN
    File1.Pattern = Text1.Text
    Exit Sub
ERR_PATTERN:
    MsgBox Text1.Text + " filename error", 48, "Error Message"
    Text1.Text = File1.Pattern
    Resume
End Sub